( Vectored execution example: )
VARIABLE CNT
: FC CR 10 0 DO I . LOOP ;
: BC CR 10 0 DO 10 I - . LOOP ;
: FWD ['] FC CNT ! ;
: REV ['] BC CNT ! ;
: GO CNT @ EXECUTE ;
: FAB FWD GO REV GO ;
: MFAB FWD 10 0 DO GO LOOP REV 10 0 DO GO LOOP ;
: FOREVER BEGIN MFAB AGAIN ;




( "I LOVE FORTH" in zig-zag across the screen: )
VARIABLE DIR VARIABLE SPC
1 DIR !  0 SPC !
: DOSPC DIR @ SPC +! ;
: CHECK SPC @ DUP 0= IF 1 DIR ! THEN 20 = IF -1 DIR ! THEN DOSPC ;
: MSG BEGIN SPC @ SPACES ." I LOVE FORTH" CR CHECK BREAK? AGAIN ;




Re-vectored MKDSK with error checking:
: MKDSK [COMPILE] MKDSK DUP 0> IF ." DISK ERROR:" . ELSE DROP THEN ; IMMEDIATE
More efficient version:
: MKDSK [COMPILE] MKDSK ?DUP IF ."ERROR:" . THEN ; IMMEDIATE




: CASE 0 ; IMMEDIATE
: OF COMPILE OVER COMPILE = [COMPILE] IF COMPILE DROP ; IMMEDIATE
: ENDOF [COMPILE] ELSE ; IMMEDIATE
: ENDCASE COMPILE DROP BEGIN ?DUP WHILE [COMPILE] THEN REPEAT ; IMMEDIATE

( case test )
: TEST
  KEY CASE
  32 OF ." SPACE " ENDOF
  42 OF ." STAR " ENDOF
  13 OF ." ENTER " ENDOF
  ." UNKNOWN "
  ENDCASE
;
: L BEGIN TEST BREAK? AGAIN ;






( MOVEMENT EXAMPLE )
10 VALUE X  10 VALUE Y  0 VALUE MX
: CLIP X Y 24 MOD SWAP 40 MOD SWAP GOTOXY ;
: SHOW CLIP 42 EMIT ; 
: ERASE CLIP 32 EMIT ;
: UP ERASE -1 +TO Y SHOW ;
: LEFT ERASE -1 +TO X SHOW ;
: RIGHT ERASE 1 +TO X SHOW ;
: DOWN ERASE 1 +TO Y SHOW ;
: KEYS? KEY?
  CASE
   69 OF UP ENDOF
   83 OF LEFT ENDOF
   68 OF RIGHT ENDOF
   88 OF DOWN ENDOF
  ENDCASE ;
: MSHOW MX 0 GOTOXY ."  ####" 1 +TO MX MX 760 MOD TO MX ;
: GO PAGE SHOW BEGIN MSHOW KEYS? BREAK? AGAIN ;






: DUMP ( addrddr count -- )
 BASE @ >R
 ZEROS @ >R 
 TRUE ZEROS !  CR 
 2/
 0 DO
	 62 EMIT  DUP $.
	 4 FOR @++ SWAP $. NExt
	 8 -
	 8 FOR 
	   DUP C@ DUP
	   32 128 WITHIN
	   NOT IF DROP 46 THEN EMIT 1+ 
	 NExt
	 CR KEY? 2 = IF LEAVE THEN
 4 +LOOP
 DROP
 R> ZEROS !
 R> BASE !
;





( GRAPHICS DEFINITION TEST )
: UDG 
  HEX 0607 0302 0703 0103 DECIMAL 4 40 DCHAR
  HEX 0707 0E0D 0306 070E DECIMAL 4 41 DCHAR
  HEX 00C0 E0C0 C0C0 80C0 DECIMAL 4 42 DCHAR
  HEX E0E0 F0F0 C0E0 60E0 DECIMAL 4 43 DCHAR
;
: SHOW 1 GMODE UDG 40 EMIT 42 EMIT CR 41 EMIT 43 EMIT CR ;





( 32 column mode colour demo )
: DoBlocks 128 FOR FFFF$ FFFF$ FFFF$ FFFF$ 4 I 128 + DCHAR NExt ;
: CharSet 3 FOR 256 FOR I EMIT NExt NExt ;
: Colours 0 2 BEGIN 32 FOR 1+ SWAP 1+ SWAP 2DUP I -ROT COLOR NExt 
  1+ SWAP 1+ SWAP BREAK? AGAIN ;
: DEMO 1 GMODE CharSet DoBlocks Colours ;



( scroll test )
1 GMODE
: KEYS? KEY?
  CASE
   69 OF 4 SCROLL ENDOF
   83 OF 0 SCROLL ENDOF
   68 OF 2 SCROLL ENDOF
   88 OF 6 SCROLL ENDOF
  ENDCASE ;
: GO 0 0 32 10 PANEL TRUE WRAP !
     WORDS BEGIN KEYS? BREAK? AGAIN ;

	 
	 
: MALE   CREATE DOES> DROP ." IS MALE"   CR ;
: FEMALE CREATE DOES> DROP ." IS FEMALE" CR ;
MALE BEN
MALE TAYLOR
MALE THOMAS
MALE JOSH
FEMALE ALEA
BEN
TAYLOR
THOMAS
JOSH
ALEA




( DATA> and <DATA )

: <DATA ;
: DATA>
  HERE 4 CELLS + [COMPILE] LITERAL
  COMPILE BRANCH HERE 0 ,
  0 BEGIN            ( count )
    WORD DUP         ( count addr len len )
    IF               ( count addr len )
      ( found a string in TIB )
      2DUP FIND      ( count addr len dict-addr )
      DUP IF         ( count addr len dict-addr )
        ( it's a known word )
        >CFA         ( count addr len xt )
        DUP          ( count addr len xt xt )
        ['] <DATA    ( count addr len xt xt <data-xt )
        <> IF        ( count addr len xt )
          ( it's not <DATA, compile it )
          ,          ( count addr len )
          2DROP      ( count )
          ( increment data item count )
          1+         ( count )
          ( do another word from TIB )
          FALSE      ( count false )
        ELSE         ( count addr len xt )
          ( it's <DATA - clean up and push TRUE to exit UNTIL loop )
          DROP 2DROP ( count )
          TRUE       ( count true )
        THEN
      ELSE           ( count addr len dict-addr )
        ( not a dictionary entry, try a number )
        DROP         ( count addr len )
        NUMBER       ( count num err )
        0= IF        ( count num )
          ( it's a number, compile it and increment data count )
          ,          ( count )
          1+         ( count )
          FALSE      ( count false )
        ELSE         ( count num )
          ( not a number, discard )
          DROP       ( count )
          FALSE      ( count false )
        THEN
      THEN
    ELSE
      TRUE           ( count true )
    THEN
  UNTIL              ( count )
  ( calculate branch offset and store )
  SWAP DUP HERE SWAP - SWAP ! 
  ( compile data count )
  [COMPILE] LITERAL
; IMMEDIATE

: TEST ." hello! " DATA> 1 2 3 4 DROP DUP SWAP <DATA ." goodbye!" ;
TEST HEX U. U. DECIMAL



------

alternative (shorter) data.

Use: DATA <count> .... ....


: DATA ( -- addr len )
  HERE 12 + [COMPILE] LITERAL ( -- )
  WORD NUMBER DROP DUP [COMPILE] LITERAL 
  COMPILE BRANCH HERE 0 ,  
  SWAP 0 DO WORD NUMBER DROP , LOOP
  DUP HERE SWAP - SWAP !

Compiled equivalent:
--------------------
A008: 8320 784C 71A2 000C  docol ghere lit 12
A010: 62FC 71B6 6C96 6D02  add litral word number
A018: 612C 6150 71B6 737E  drop dup litral compile
A020: 658E 784C 71A2 0000  branch ghere lit0
A028: 71C6 613A 71A2 0000  comma swap lit0
A030: 66D6 6C96 6D02 612C  do word number drop 
A038: 71C6 6708 6150 784C  comma loop dup ghere
A040: 613A 630C 613A 685A  swap sub swap store
A048: 832E                 exit